home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Pd / Pyth2.e < prev    next >
Encoding:
Text File  |  1994-12-01  |  7.7 KB  |  213 lines
  1. /*
  2. **      C'est la version E de 'l'arbre de Pythagore'.
  3. **      Ecrit par Raymond Hoving, Waardgracht 30, 2312 RP Leiden,
  4. **      Pays-Bas.
  5. **      E-mail address: hoving@stpc.wi.leidenuniv.nl
  6. **      Nécessite Kickstart V3.0+ et le reqtools.library V38+
  7. **      Date de création : Sun Jul 17 17:30:07 1994, Version: 2.0
  8. */
  9.  
  10. OPT     REG=5,OSVERSION=39      /* Kickstart 3.0+ only. */
  11.  
  12. MODULE  'intuition/intuition', 'intuition/screens', 'utility/tagitem',
  13.         'reqtools', 'exec/ports', 'exec/libraries',
  14.         'libraries/reqtools', 'graphics/modeid', 'graphics/text'
  15.  
  16. DEF     pythscreen=NIL : PTR TO screen,
  17.         pythwindow=NIL : PTR TO window,
  18.         pythidcmp=NIL : PTR TO mp,
  19.         screenmodereq=NIL : PTR TO rtscreenmoderequester,
  20.         scrwidth, scrheight, fontheight,
  21.         winxsize, winysize, xbase, ybase, mbase,
  22.         depth=1, mdepth=10,
  23.         time0, time1
  24.  
  25. CONST   BORDERSIZE = 4
  26.  
  27. ENUM    MSG_READY, MSG_ABORT, ERROR_REQTLIB, ERROR_SCREEN,
  28.         ERROR_WINDOW, ERROR_OOM
  29.  
  30. PROC    pythcleanup(errornumber)
  31.  
  32.         /* Cette procédure va désallouer tous les objets qui ont bien été
  33.         ** alloués. Quand une erreur arrive, il sera dit à l'utilisateur.
  34.         */
  35.  
  36.         IF pythwindow<>NIL THEN CloseWindow(pythwindow)
  37.         IF pythscreen<>NIL THEN CloseScreen(pythscreen)
  38.         IF screenmodereq<>NIL THEN RtFreeRequest(screenmodereq)
  39.         IF reqtoolsbase<>NIL THEN CloseLibrary(reqtoolsbase)
  40.         SELECT  errornumber
  41.                 CASE ERROR_OOM
  42.                         WriteF('ERREUR: Plus de mémoire.\n')
  43.                 CASE ERROR_REQTLIB
  44.                         WriteF('ERREUR: Ne peut pas ouvrir la reqtools.library.\n')
  45.                 CASE ERROR_SCREEN
  46.                         WriteF('ERREUR: Ne peut pas ouvrir un nouvel écran.\n')
  47.                 CASE ERROR_WINDOW
  48.                         WriteF('ERREUR: Ne peu pas ouvrir une nouvelle fenêtre.\n')
  49.                 CASE MSG_ABORT
  50.                         WriteF('Ecriture annulée.\n')
  51.                 CASE MSG_READY
  52.                         WriteF('J'ai juste tracé \d petite maison\s!\n',
  53.                                 Shl(1,mdepth)-1,
  54.                                 IF mdepth=1 THEN '' ELSE 's')
  55.         ENDSELECT
  56.         CleanUp(errornumber)    /* Appelle le nettoyeur standard E. */
  57. ENDPROC
  58.  
  59. PROC    pythtree(a1,a2,b1,b2)
  60.  
  61.         /* cette procédure (récursivement appellée) tracera l'actuel arbre
  62.         */
  63.  
  64.         DEF c1,c2,d1,d2,e1,e2,ci1,ci2,di1,di2
  65.         IF GetMsg(pythidcmp)<>NIL THEN pythcleanup(MSG_ABORT)
  66.         IF depth<=mdepth                /* Vérifie si on n'est pas trop profond. */
  67.           INC depth                     /* Cette profondeur est encore permise. */
  68.           SetAPen(stdrast,depth)        /* La couleur du tracé dépend de la profondeur. */
  69.           c1 := !a1-a2+b2 ; ci1 := !c1!
  70.           c2 := !a1+a2-b1 ; ci2 := !c2!
  71.           d1 := !b1+b2-a2 ; di1 := !d1!
  72.           d2 := !a1-b1+b2 ; di2 := !d2! /* Calculte toutes les */
  73.           e1 := !0.5 * (!c1-c2+d1+d2)   /* coordonnées necéssaires. */
  74.           e2 := !0.5 * (!c1+c2-d1+d2)
  75.           /*
  76.           **         e      Notez l'utilisation de ! entre les () dans les calculs de e1 et
  77.           **        /\      e2. On utilisie quelques LONG en plus pour minimiser les convertions
  78.           **       /  \
  79.           **     c+----+d   Les coordonées de c,d et e sont calculés à partir des coordonnées
  80.           **      |    |    de a et b. L'algèbre linéaire, quel joie !
  81.           **      |    |
  82.           **     a+----+b
  83.           */
  84.           Move(stdrast,ci1,ci2)
  85.           Draw(stdrast,!a1!,!a2!)
  86.           Draw(stdrast,!b1!,!b2!)
  87.           Draw(stdrast,di1,di2)
  88.           Draw(stdrast,ci1,ci2)
  89.           Draw(stdrast,!e1!,!e2!)
  90.           Draw(stdrast,di1,di2)         /* Trace la petite maison. */
  91.           IF Rnd(2) = 0                 /* Fait la croissance un   */
  92.             pythtree(c1,c2,e1,e2)       /* peu plus interessant.   */
  93.             pythtree(e1,e2,d1,d2)
  94.           ELSE
  95.             pythtree(e1,e2,d1,d2)
  96.             pythtree(c1,c2,e1,e2)
  97.           ENDIF
  98.           DEC depth                     /* Prêt avec cette branche. */
  99.         ENDIF
  100. ENDPROC
  101.  
  102. PROC    main()
  103.  
  104.         DEF a1,a2,b1,b2
  105.  
  106.         /* Ouvre la reqtools.library et alloue la mémoire pour le strucuure des requesters.
  107.         */
  108.  
  109.         IF (reqtoolsbase := OpenLibrary('reqtools.library',38)) = NIL THEN
  110.           pythcleanup(ERROR_REQTLIB)
  111.  
  112.         IF (screenmodereq := RtAllocRequestA(RT_SCREENMODEREQ,NIL)) = NIL THEN
  113.           pythcleanup(ERROR_OOM)
  114.  
  115.         /* Laisse l'utilisateur décider quel mode écran il veut. Notez que
  116.         ** l'arbre est le mieux sur un écran qui a approximativement le même
  117.         ** nombre de pixels dans les 2 directions, comme 640x512.
  118.         */
  119.  
  120.         IF RtScreenModeRequestA(screenmodereq,'Arbre de Pythagore', [
  121.           RTSC_FLAGS,SCREQF_OVERSCANGAD OR SCREQF_AUTOSCROLLGAD OR SCREQF_SIZEGADS,
  122.           RTSC_MINWIDTH,100,
  123.           RTSC_MINHEIGHT,100,
  124.           TAG_DONE]) = FALSE THEN pythcleanup(MSG_ABORT)
  125.  
  126.         /* Puis demande la profondeur maximum de récursion.
  127.         */
  128.  
  129.         IF (RtGetLongA({mdepth},'Arbre de Pythagore',NIL, [
  130.           RTGL_MIN,1,
  131.           RTGL_MAX,14,
  132.           RTGL_TEXTFMT,'Entrez la profondeur maximum de l\aarbre :',
  133.           RT_WINDOW,pythwindow,
  134.           TAG_DONE])) = FALSE THEN pythcleanup(MSG_ABORT)
  135.  
  136.         /* Prend les données importantes de la structure d'écran.
  137.         */
  138.  
  139.         scrwidth := screenmodereq.displaywidth
  140.         scrheight := screenmodereq.displayheight
  141.  
  142.         /* Ouvre l'écran que l'utilisteur voulait.
  143.         */
  144.  
  145.         IF (pythscreen := OpenScreenTagList(NIL, [
  146.           SA_DEPTH,4,
  147.           SA_TYPE,CUSTOMSCREEN,
  148.           SA_DISPLAYID,screenmodereq.displayid,
  149.           SA_WIDTH,scrwidth,
  150.           SA_HEIGHT,scrheight,
  151.           SA_TITLE,'Screen of Pythagoras',
  152.           TAG_DONE])) = NIL THEN pythcleanup(ERROR_SCREEN)
  153.  
  154.         /* Maintenant ouvre un écran de remplissage sur l'écran qui vient d'être ouvert.
  155.         */
  156.  
  157.         IF (pythwindow:=OpenWindowTagList(NIL, [
  158.           WA_WIDTH,scrwidth,
  159.           WA_HEIGHT,scrheight,
  160.           WA_IDCMP,IDCMP_CLOSEWINDOW,
  161.           WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_ACTIVATE,
  162.           WA_TITLE,'Arbre de Pythagore par Raymond Hoving',
  163.           WA_CUSTOMSCREEN,pythscreen,
  164.           TAG_DONE])) = NIL THEN pythcleanup(ERROR_WINDOW)
  165.  
  166.         /* Prend quelques données utiles de la structure fenêtre.
  167.         */
  168.  
  169.         stdrast := pythwindow.rport
  170.         pythidcmp := pythwindow.userport
  171.         fontheight := pythwindow.ifont::textfont.ysize
  172.  
  173.         /* Fixe la palette pour cet écran (marron à vert).
  174.         */
  175.  
  176.         LoadRGB4(ViewPortAddress(pythwindow), [
  177.           $000,$89a,$640,$752,$762,$771,$781,$680,$580,$080,
  178.           $090,$0a0,$0b0,$0c0,$0d0,$0e0] : INT, 16)
  179.  
  180.  
  181.         /* Contruit un seuil 'au hasard' à partir de l'heure
  182.         */
  183.  
  184.         CurrentTime({time0},{time1})
  185.         Rnd(-Abs(Eor(time0,time1)))
  186.  
  187.         /* Calcule la taille possible de l'arbre sur cet écran.
  188.         */
  189.  
  190.         winxsize := scrwidth - (2 * BORDERSIZE)
  191.         winysize := scrheight - (6 * BORDERSIZE + fontheight)
  192.         xbase := winxsize! / 12.2       /* Diviseur touvé par trial et erreur. */
  193.         ybase := winysize! / 8.0        /* Celui-ci est bon.                   */
  194.         IF !xbase < ybase THEN mbase := xbase ELSE mbase := ybase
  195.         a1 := scrwidth! / 2.0 - mbase
  196.         b1 := scrwidth! / 2.0 + mbase
  197.         a2 := scrheight - (4 * BORDERSIZE)!
  198.         b2 := a2
  199.  
  200.         /* Met le busy pointer et comence à tracer.
  201.         */
  202.  
  203.         SetWindowPointerA(pythwindow,[WA_BUSYPOINTER,TRUE,TAG_DONE])
  204.         pythtree(a1,a2,b1,b2)
  205.         SetWindowPointerA(pythwindow,TAG_DONE)
  206.  
  207.         /* Prêt ! Attend que l'utilisateur ferme l'écran.
  208.         */
  209.  
  210.         WaitPort(pythidcmp)
  211.         pythcleanup(MSG_READY)
  212. ENDPROC
  213.